home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / sys / unix_gc.t < prev    next >
Text File  |  1988-02-05  |  1KB  |  42 lines
  1. (herald unix_gc (env tsys))
  2.  
  3. ;;; Initialize the available areas and set up the relevant
  4. ;;; system and process globals.
  5.  
  6. (define (initialize-areas)
  7.   (let* ((boot-args (system-global  slink/boot-args))
  8.          (heap-size (vref boot-args 3)))
  9.     (set *old-space* 
  10.          (create-area 'area1
  11.                       (vref boot-args 2)
  12.                       heap-size
  13.                       nil))
  14.     (set *new-space*                            ; current area
  15.          (create-area 'area0
  16.                       (vref boot-args 1)
  17.                       heap-size
  18.                       nil))
  19.     (set (area-base *new-space*)
  20.          (system-global slink/boot-area-base))
  21.     (set (process-global task/area) *new-space*)))
  22.  
  23. (define (zero-out-area area) (return))
  24.  
  25. ;;; In the following strings that are passed to printf we make sure that there
  26. ;;; are not a multiple of 4 bytes so the strings are actually asciz!!!  Yuk
  27.  
  28. (define gc-message
  29.   (let ((string (copy-string "; %d objects copied  ")))
  30.     (set (string-elt string 20) #\newline)
  31.     (lambda (count)
  32.       (printf-number string count))))
  33.  
  34. (define (gc-error-message string address)
  35.   (unix-write-string 1 "GC error: " 10)
  36.   (unix-write-string 1 string (string-length string))
  37.   (printf-number " %x\n" address))
  38.  
  39. (define-foreign printf-number (printf (in rep/string)
  40.                                       (in rep/integer))
  41.        rep/integer)
  42.